home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / simula / books / books.lha / kirkerud / arrproc.sim < prev    next >
Text File  |  1993-08-16  |  7KB  |  206 lines
  1. begin
  2.  
  3.   procedure Min_max_in_1dim_array(arr, low_ind, high_ind, 
  4.                        min_val, max_val);
  5.       name min_val, max_val;
  6.       integer array arr; 
  7.       integer low_ind, high_ind, min_val, max_val;
  8.     begin 
  9.       integer ind;
  10.       min_val := maxint;  max_val := minint;
  11.       for ind := low_ind step 1 until high_ind do
  12.         begin
  13.           min_val := min(arr(ind), min_val);
  14.           max_val := max(arr(ind), max_val);
  15.         end;
  16.     end of Min_max_in_1dim_array;
  17.  
  18.   procedure Min_max_in_2dim_array(arr, low_ind1, high_ind1, 
  19.                        low_ind2, high_ind2, 
  20.                        min_val, max_val);
  21.       name min_val, max_val;
  22.       integer array arr; 
  23.       integer low_ind1, high_ind1, low_ind2, high_ind2, min_val, max_val;
  24.     begin 
  25.       integer ind1, ind2;
  26.       min_val := maxint;  max_val := minint;
  27.       for ind1 := low_ind1 step 1 until high_ind1 do
  28.         for ind2 := low_ind2 step 1 until high_ind2 do
  29.         begin
  30.           min_val := min(arr(ind1, ind2), min_val);
  31.           max_val := max(arr(ind1, ind2), max_val);
  32.         end;
  33.     end of Min_max_in_2dim_array;
  34.  
  35.   procedure Slowsort(arr, low_ind, high_ind);
  36.       integer array arr; integer low_ind, high_ind;
  37.     begin 
  38.       integer ind;
  39.       for ind := low_ind step 1 until high_ind - 1 do
  40.         Swap(arr, ind, min_ind_in_1dim_array(arr, ind, high_ind));
  41.     end of Slowsort;
  42.  
  43.   procedure Swap(arr, ind1, ind2);
  44.       integer array arr; integer ind1, ind2;
  45.     if ind1 ne ind2 then
  46.     begin integer temp; 
  47.       temp := arr(ind1);
  48.       arr(ind1) := arr(ind2); arr(ind2) := temp;
  49.     end of Swap;
  50.  
  51.   integer procedure min_ind_in_1dim_array(arr, low_ind, high_ind);
  52.       integer array arr;  integer low_ind, high_ind;
  53.     begin integer ind, min_ind;
  54.        min_ind := low_ind;
  55.        for ind := low_ind + 1 step 1 until high_ind do
  56.          if arr(ind) < arr(min_ind) then min_ind := ind;
  57.        min_ind_in_1dim_array := min_ind;
  58.     end;
  59.  
  60.   procedure Merge(A, B, C, a_high, b_high, c_high);
  61.       name c_high;
  62.       integer array A, B, C;
  63.       integer a_high, b_high, c_high;
  64.     begin
  65.       integer a_ind, b_ind, c_ind, a_val, b_val;
  66.       Boolean a_finished, b_finished;
  67.       a_ind := 1; a_val := A(a_ind); a_finished := false;
  68.       b_ind := 1; b_val := B(b_ind); b_finished := false;
  69.       c_ind := 0;
  70.       while not (a_finished and b_finished) do
  71.         begin ! a_finished will be true when all elements in A have
  72.               ! been merged into C, similarily with b_finished.
  73.               ! Because now not both a_finished and b_finished , 
  74.               ! there must be at least
  75.               ! one element in A or B which have not found its place in C.
  76.               ! This will be done now:  ;
  77.           c_ind := c_ind + 1;
  78.           if a_val < b_val then ! This means that a_val is the element 
  79.                 ! to be placed in C;
  80.             begin 
  81.               C(c_ind) := a_val; 
  82.               a_ind := a_ind + 1;  ! Find the next element in A;
  83.               if a_ind le a_high then a_val := A(a_ind)
  84.               else begin a_val := maxint; a_finished := true end;
  85.             end
  86.           else begin 
  87.               C(c_ind) := b_val; 
  88.               b_ind := b_ind + 1;
  89.               if b_ind le b_high then b_val := B(b_ind)
  90.               else begin b_val := maxint; b_finished := true end;
  91.             end
  92.         end;
  93.       c_high := c_ind;
  94.     end of Merge;
  95.  
  96.   procedure give_help;
  97.     begin
  98.       outtext("Legal commands: "); outimage;
  99.       outtext("   ?   give help"); outimage;
  100.       outtext("   r:  read array "); outimage;
  101.       outtext("   m:  test merge "); outimage;
  102.       outtext("   s:  test Slowsort "); outimage;
  103.       outtext("   x:  test findminmax "); outimage;
  104.       outtext("   w:  write arrays"); outimage;
  105.       outtext("   q:  quit testing"); outimage;
  106.     end of give_help;
  107.  
  108.   procedure read_array;
  109.     begin character arrchar;
  110.       arrchar := prompt_for_char("Read A, B or C? ");
  111.       if arrchar = 'A' then read_arr(A, na) else
  112.       if arrchar = 'B' then read_arr(B, nb) 
  113.       else read_arr(C, nc);
  114.     end;
  115.  
  116.   procedure read_arr(arr, narr); 
  117.       name narr; integer array arr; integer narr;
  118.     begin integer ind;
  119.       narr := prompt_for_int("How many elements? ");
  120.       for ind := 1 step 1 until narr do
  121.         arr(ind) := prompt_for_int("Type an element> ");
  122.     end of read_arr;
  123.  
  124.   integer procedure prompt_for_int(prompt); text prompt;
  125.     begin
  126.       outtext(prompt); breakoutimage;
  127.       inimage; prompt_for_int := inint;
  128.     end;
  129.  
  130.   character procedure prompt_for_char(prompt); text prompt;
  131.     begin
  132.       outtext(prompt); breakoutimage;
  133.       inimage; prompt_for_char := inchar;
  134.     end;
  135.  
  136.   procedure test_merge;
  137.     Merge(A, B, C, na, nb, nc);
  138.  
  139.   procedure test_Slowsort;
  140.     begin character arrchar;
  141.       arrchar := prompt_for_char("Slowsort A, B or C? ");
  142.       if arrchar = 'A' then 
  143.         begin Slowsort(A, 1, na); write_array("A", A, na) end else
  144.       if arrchar = 'B' then
  145.         begin Slowsort(B, 1, nb); write_array("B", B, nb) end else
  146.       if arrchar = 'C' then
  147.         begin Slowsort(C, 1, nc); write_array("C", C, nc) end;
  148.     end of test_Slowsort;
  149.  
  150.   procedure test_findminmax;
  151.     begin character arrchar; integer min_val, max_val;
  152.       arrchar := prompt_for_char("Minmax for A, B or C? ");
  153.       if arrchar = 'A' then 
  154.         Min_max_in_1dim_array(A, 1, na, min_val, max_val) else
  155.       if arrchar = 'B' then
  156.         Min_max_in_1dim_array(B, 1, nb, min_val, max_val) 
  157.      else
  158.         Min_max_in_1dim_array(C, 1, nc, min_val, max_val);
  159.      outtext("Minimum in "); outchar(arrchar); outtext(": "); outint(min_val,6);
  160.      outtext("  Maximum: "); outint(max_val,6); outimage;
  161.     end of test_findminmax;
  162.  
  163.   procedure write_arrays;
  164.     begin
  165.       write_array("A", A, na);
  166.       write_array("B", B, nb);
  167.       write_array("C", C, nc);
  168.     end of write_arrays;
  169.  
  170.   procedure write_array(arr_name, arr, arr_length);
  171.       text arr_name; integer array arr; integer arr_length;
  172.     begin integer ind;
  173.       outtext("Array "); outtext(arr_name); 
  174.       outtext(" has "); outint(arr_length, 3); outtext(" elements:"); outimage;
  175.       for ind := 1 step 1 until arr_length do
  176.         outint(arr(ind), 10);
  177.       outimage;
  178.     end of write_array;
  179.  
  180.   procedure unknown_test;
  181.     begin
  182.       outtext("Unknown test"); outimage;
  183.       Give_help;
  184.     end of unknown_test;
  185.  
  186.   integer array A, B, C(1 : 100); 
  187.   integer na, nb, nc;
  188.  
  189.   Boolean more_testing;
  190.  
  191.   more_testing := true;
  192.   while more_testing do
  193.     begin character c;
  194.       c := prompt_for_char("Which test do you want to perform? "); 
  195.       if c = '?' then give_help else
  196.       if c = 'r' then read_array else
  197.       if c = 'm' then test_merge else
  198.       if c = 's' then test_Slowsort else
  199.       if c = 'x' then test_findminmax else
  200.       if c = 'w' then write_arrays else
  201.       if c = 'q' then more_testing := false
  202.       else unknown_test;
  203.     end;
  204.  
  205. end
  206.